View Code Snippet

Author: Adam Melton/ (redoo of yesterdays and better) this is a mod of Frank Kley's 128 bit encryption
Date Submitted: 1/20/2005
Category: Security Code and Programs
Compatibility: VB 6
This code has been accessed 848 times.

Task: This program lets you decide the passkey length to b generated. Also it lets you copy and paste in the cryptkey box so that you can send e-mail and if the reciever has this same program they can use the crypt key to decode.

Declarations

Code

Private Sub Form_Load() Text3.Text = "128" Call GenKeyB_Click End Sub Function GenCryptKey() As String keylen = Text3.Text s = Int(Right(Timer, 5)) For i = 1 To keylen For t = 0 To s Rnd Next t a$ = Chr$(Int(Rnd * 255)) CR = CR + a$ Next i GenCryptKey = CR End Function Function Crypt(Inpu As String, CKey As String) As String EXPO = 3 DL = 2 ^ EXPO For i = 1 To Len(Inpu) W = Asc(Mid$(Inpu, i, 1)) + Asc(Mid$(CKey, DL, 1)) If W > 255 Then W = W - 255 a$ = a$ + Chr$(W) DL = DL + 1 If DL > 2 ^ (EXPO + 1) Then If EXPO = 6 Then EXPO = 3: GoTo EXPSET If EXPO = 3 Then EXPO = 5: GoTo EXPSET If EXPO = 5 Then EXPO = 2: GoTo EXPSET If EXPO = 2 Then EXPO = 4: GoTo EXPSET If EXPO = 4 Then EXPO = 1: GoTo EXPSET If EXPO = 1 Then EXPO = 0: GoTo EXPSET If EXPO = 0 Then EXPO = 6: GoTo EXPSET EXPSET: DL = 2 ^ EXPO End If Next i Crypt = a$ End Function Function DeCrypt(Inpu As String, CKey As String) As String EXPO = 3 DL = 2 ^ EXPO For i = 1 To Len(Inpu) W = Asc(Mid$(Inpu, i, 1)) - Asc(Mid$(CKey, DL, 1)) If W < 0 Then W = W + 255 a$ = a$ + Chr$(W) DL = DL + 1 If DL > 2 ^ (EXPO + 1) Then If EXPO = 6 Then EXPO = 3: GoTo EXPSET If EXPO = 3 Then EXPO = 5: GoTo EXPSET If EXPO = 5 Then EXPO = 2: GoTo EXPSET If EXPO = 2 Then EXPO = 4: GoTo EXPSET If EXPO = 4 Then EXPO = 1: GoTo EXPSET If EXPO = 1 Then EXPO = 0: GoTo EXPSET If EXPO = 0 Then EXPO = 6: GoTo EXPSET EXPSET: DL = 2 ^ EXPO End If Next i DeCrypt = a$ End Function Private Sub CryptB_Click() Text2.Text = Crypt(Text1.Text, CR_Key.Text) End Sub Private Sub DeCryptB_Click() Text4.Text = DeCrypt(Text2.Text, CR_Key.Text) End Sub Private Sub GenKeyB_Click() keylen = Text3.Text CR_Key.Text = "" While Len(CR_Key.Text) <> keylen CR_Key.Text = GenCryptKey Wend End Sub Private Sub Text3_click() Text3.Text = "" End Sub